home *** CD-ROM | disk | FTP | other *** search
/ Collection of Tools & Utilities / Collection of Tools and Utilities.iso / keyb / keydef03.zip / KEYDEF.BAS < prev    next >
BASIC Source File  |  1993-02-08  |  10KB  |  173 lines
  1. 1000 '   ***KEYDEF    - DOS key reassign program  by Michael L. O'Neill
  2. 1010 '           PC Magazine May 29,1984  Page 387-388
  3. 1020 '
  4. 1030 '   Modified for color monitor by Bob Shannon May 10,1984
  5. 1040 '  Modified by Jim Groeneveld, Jan 1989, May 1990, Feb 1993 (vs. 0.3)
  6. 1050 '
  7. 1060 ' For DOS 2.0 and up only - and you must have ANSI.SYS loaded !
  8. 1070 '   Have the line
  9. 1080 '                 DEVICE = [path]ANSI.SYS
  10. 1090 '                                         in your CONFIG.SYS file.
  11. 1100 '
  12. 1110 '  To use : 1. Run this program under BASIC or BASICA or GWBASIC
  13. 1120 '                   (use the } character for <RETURN>
  14. 1130 '           2. This program stores data in a file you name.
  15. 1140 '                   In DOS, enter the command:  TYPE 'name'
  16. 1150 '                   where 'name' is the name of that file.
  17. 1160 '
  18. 1170 '-------------------------------------------------------------
  19. 1190 OPTION BASE 1:DEFINT A-Z:CR$="}":DQ$=CHR$(34)
  20. 1200 BL=190
  21. 1210 WIDTH 80:KEY OFF:CLS
  22. 1220 ON ERROR GOTO 1360
  23. 1230 FOR I= 1 TO 10:KEY I,"":NEXT I
  24. 1240 DIM A$(101)          'Name of redefined key (one more element for scratch)
  25. 1250 DIM B$(100)          'string assigned to key
  26. 1260 DIM C$(100)          'string saved to DOS file
  27. 1265 DIM D$(32)           'code key names for ascii values 1-32
  28. 1270 DIM E$(140)          'Extended code key names
  29. 1275 DIM  L(100)          'length of (extended) key
  30. 1280 GOSUB 2300           'Opening screen
  31. 1290 GOSUB 1940           'Load ascii and extended codes into D$ and E$ array
  32. 1300 GOSUB 1420           'Ask filename & process file contents
  33. 1310 GOSUB 1510           'Print existing definitions to screen
  34. 1320                      '& solicit key to be redefined or stop
  35. 1330 GOSUB 2150           'save key redefinitions (or cancel) and quit
  36. 1340 LOCATE 25,1:PRINT "Choose from: E)dit same again / R)ead (new) file / Q)uit to DOS / B)asic prompt";
  37. 1342 I$=INKEY$:WHILE I$="":WHILE I$="":I$=INKEY$:WEND:IF INSTR("EeRrQqBb",I$)=0 THEN BEEP:I$="":WEND
  38. 1344 IF INSTR("Ee",I$)<>0 THEN 1310
  39. 1346 IF INSTR("Rr",I$)<>0 THEN 1300
  40. 1347 IF INSTR("Qq",I$)<>0 THEN ON ERROR GOTO 0:SYSTEM
  41. 1348 IF INSTR("Bb",I$)<>0 THEN CLS:LOCATE 25,1:PRINT "Type 'CONT <CR>' to resume with last redefinitions";:LOCATE 1,1:ON ERROR GOTO 0:END:ON ERROR GOTO 1360:GOTO 1310 'to continue anyway
  42. 1349 STOP 'this statement may never be executed, if so: an error in programming
  43. 1350 '
  44. 1360 '   error handling subroutine
  45. 1370 '
  46. 1380 IF ERL=1460 AND ERR=53 THEN RESUME 1490
  47. 1400 CLS:PRINT "Error code ";ERR;" in line #",ERL:END
  48. 1410 '
  49. 1420 '   open key file to hold definitions
  50. 1430 '
  51. 1440 CLS:LOCATE 13,1
  52. 1450 PRINT "Enter name of file for Keyboard Reassignments [C:\DOSKEYRE.DEF]: ":
  53. 1455 INPUT "",F$:IF F$="" THEN F$="C:\DOSKEYRE.DEF"
  54. 1460 N=0:OPEN "i",#1,F$
  55. 1470 WHILE NOT EOF(1) AND N<100:N=N+1:LINE INPUT #1,C$(N):GOSUB 1820:WEND
  56. 1480 NK=N:CLOSE '====== a maximum of 100 lines (definitions) read
  57. 1490 RETURN
  58. 1500 '
  59. 1510 '   List current definitions
  60. 1520 '
  61. 1530 CLS:LOCATE 1,1:PRINT "Filename: ";F$;TAB(59);CR$;"=CR";
  62. 1540 BU=0:LOCATE 2,1:FOR N=1 TO NK
  63. 1560 BU=BU+L(N)+LEN(B$(N))
  64. 1570 PRINT A$(N),B$(N)
  65. 1580 NEXT N':LOCATE 25,1:PRINT "(DEBUG:   NK=";NK;"BU=";BU;"L=";L(NK);"LB=";LEN(B$(NK));")";
  66. 1600 LOCATE 24,1:PRINT "Press key to be redefined - Press ENTER to stop.";
  67. 1610 LOCATE 1,65:PRINT "BYTES LEFT ";BL-BU-NK+1; 'is this true???
  68. 1630 '
  69. 1640 '   Redefine a key
  70. 1650 '
  71. 1660 I$=INKEY$:IF I$="" THEN 1660 ELSE LOCATE 25,1:PRINT SPACE$(80);:IF I$=CHR$(13) THEN LOCATE 24,1:PRINT SPACE$(80);:RETURN
  72. 1670 IF LEN(I$)=1 THEN A$(N)=I$:M$=CHR$(27)+"["+MID$(STR$(ASC(A$(N))),2,3):GOSUB 2600:GOTO 1720
  73. 1700 A$(N)=E$(ASC(RIGHT$(I$,1)))
  74. 1710 M$=CHR$(27)+"[0;"+MID$(STR$(ASC(RIGHT$(I$,1))),2)
  75. 1720 FOR J=1 TO NK:IF A$(J)=A$(N) THEN N=J:GOTO 1735
  76. 1730 NEXT J:IF NK=>100 THEN NK=100:BEEP:LOCATE 25,1:PRINT "Array length exceeded, no additional keys allowed. Press any key.....";:GOTO 1510
  77. 1733 L(J)=LEN(I$):NK=NK+1
  78. 1735 LOCATE 24,1:PRINT "Key: (CR:end)│Redefinition: (EMPTY:remove,}=CR,END:default,CR:accept,ESC:cancel)";
  79. 1740 LOCATE 25,14:PRINT "│";:LOCATE 25,1
  80. 1750 PRINT A$(N);:LOCATE 25,15:PRINT B$(N);:LOCATE 25,15:LINE INPUT;B$(N)
  81. 1760 IF B$(N)="" THEN GOSUB 2240:GOTO 1790
  82. 1770 C$(N)=B$(N):N$=DQ$+"p":IF RIGHT$(C$(N),1)=CR$ THEN C$(N)=MID$(C$(N),1,LEN(C$(N))-1):N$=DQ$+";13p" '=== convert trailing CR in definition
  83. 1771 I=1
  84. 1772 J=INSTR(I,C$(N),DQ$):IF J<>0 THEN C$(N)=MID$(C$(N),1,J-1)+DQ$+";34;"+DQ$+MID$(C$(N),J+1):I=J+6:GOTO 1772 '=== convert embedded DQ's in definition
  85. 1774 I=1
  86. 1775 J=INSTR(I,C$(N),CR$):IF J<>0 THEN C$(N)=MID$(C$(N),1,J-1)+DQ$+";13;"+DQ$+MID$(C$(N),J+1):I=J+6:GOTO 1775 '=== convert embedded CR's in definition
  87. 1780 C$(N)=M$+";"+DQ$+C$(N)+N$
  88. 1784 I=1 '***** NOTE ***** Remove the next line (make it comment) for not simplifying output, but enabling better compatible input (file input is not yet ideal)
  89. 1785 J=INSTR(I,C$(N),";"+DQ$+DQ$):IF J<>0 THEN C$(N)=MID$(C$(N),1,J-1)+MID$(C$(N),J+3):I=J:GOTO 1785 '=== delete eventually developed ';""' in definition
  90. 1790 GOTO 1510
  91. 1810 '
  92. 1820 '   Get key name and redefinition
  93. 1830 '
  94. 1840 IF MID$(C$(N),3,2)="0;" THEN L(N)=2:GOTO 1880
  95. 1850 L(N)=1:A$(N)=CHR$(VAL(MID$(C$(N),3,INSTR(C$(N),";")-3)))
  96. 1860 GOSUB 2600
  97. 1870 GOTO 1890
  98. 1880 A$(N)=E$(VAL(MID$(C$(N),5,INSTR(5,C$(N),";")-5)))
  99. 1890 B$(N)=MID$(C$(N),INSTR(C$(N),DQ$)+1) '### B$ starts AFTER FIRST DOUBLE QUOTE !!! (erroneous)
  100. 1900 IF RIGHT$(B$(N),5)=DQ$+";13p" THEN B$(N)=MID$(B$(N),1,LEN(B$(N))-5)+CR$ '=== convert trailing CR in definition
  101. 1902 IF RIGHT$(B$(N),5)=DQ$+";34p" THEN B$(N)=MID$(B$(N),1,LEN(B$(N))-5)+DQ$ '=== convert trailing DQ in definition
  102. 1905 IF RIGHT$(B$(N),2)=DQ$+"p" THEN B$(N)=MID$(B$(N),1,LEN(B$(N))-2) '=== convert end of definition
  103. 1909 I=1
  104. 1910 J=INSTR(I,B$(N),DQ$+";13;"+DQ$):IF J<>0 THEN B$(N)=MID$(B$(N),1,J-1)+CR$+MID$(B$(N),J+6):I=J+1:GOTO 1910 '=== convert embedded CR's in definition
  105. 1914 I=1
  106. 1915 J=INSTR(I,B$(N),DQ$+";34;"+DQ$):IF J<>0 THEN B$(N)=MID$(B$(N),1,J-1)+DQ$+MID$(B$(N),J+6):I=J+1:GOTO 1910 '=== convert embedded DQ's in definition
  107. 1920 RETURN
  108. 1930 '
  109. 1940 '   Fill E$ array with Extended codes
  110. 1950 '
  111. 1952 GOSUB 2133:DATA 1,32,Ctrl-A,Ctrl-B,Ctrl-C,Ctrl-D,Ctrl-E,Ctrl-F,Ctrl-G Bell
  112. 1954 DATA Ctrl-H BS,Ctrl-I Tab,Ctrl-Enter,Ctrl-K,Ctrl-L FF,Ctrl-M CR,Ctrl-N
  113. 1956 DATA Ctrl-O,Ctrl-P,Ctrl-Q,Ctrl-R,Ctrl-S,Ctrl-T,Ctrl-U,Ctrl-V,Ctrl-W,Ctrl-X
  114. 1958 DATA Ctrl-Y,Ctrl-Z,Ctrl-[ ESC,Ctrl-\,Ctrl-],Ctrl-^,Ctrl-_,Space Bar
  115. 1960 E$(3)="Ctrl-@ NULL":E$(15)="Shift Tab"
  116. 1970 GOSUB 2130:DATA 16,25,Alt-Q,Alt-W,Alt-E,Alt-R,Alt-T,Alt-Y,Alt-U,Alt-I
  117. 1980 DATA Alt-O,Alt-P
  118. 1990 GOSUB 2130:DATA 30,38,Alt-A,Alt-S,Alt-D,Alt-F,Alt-G,Alt-H,Alt-J,Alt-K,Alt-L
  119. 2000 GOSUB 2130:DATA 44,50,Alt-Z,Alt-X,Alt-C,Alt-V,Alt-B,Alt-N,Alt-M
  120. 2010 GOSUB 2130:DATA 59,68,F1,F2,F3,F4,F5,F6,F7,F8,F9,F10
  121. 2020 GOSUB 2130:DATA 71,83,Home,Cursor Up,Pg Up,0,Cursor Left,0,Cursor Right,0
  122. 2030 DATA End,Cursor Down,Pg Dn,Ins,Del
  123. 2040 GOSUB 2130:DATA 84,93,Shft-F1,Shft-F2,Shft-F3,Shft-F4,Shft-F5,Shft-F6,Shft-F7,Shft-F8,Shft-F9,Shft-F10
  124. 2050 GOSUB 2130:DATA 94,103,Ctrl-F1,Ctrl-F2,Ctrl-F3,Ctrl-F4,Ctrl-F5,Ctrl-F6,Ctrl-F7,Ctrl-F8,Ctrl-F9,Ctrl-F10
  125. 2060 GOSUB 2130:DATA 104,113,Alt-F1,Alt-F2,Alt-F3,Alt-F4,Alt-F5,Alt-F6,Alt-F7,Alt-F8,Alt-F9,Alt-F10
  126. 2070 GOSUB 2130:DATA 114,119,Ctrl-Prtsc,Crtl-Csr Left,Ctrl-Csr Rt,Ctrl-End
  127. 2080 DATA Ctrl-Pg Dn,Ctrl-Home
  128. 2090 GOSUB 2130:DATA 120,140,Alt-1,Alt-2,Alt-3,Alt-4,Alt-5,Alt-6,Alt-7,Alt-8,Alt-9,Alt-0
  129. 2100 DATA Alt-_,Alt-=,Ctrl-PgUp,F11,F12,Shft-F11,Shft-F12,Ctrl-F11,Ctrl-F12,Alt-F11,Alt-F12
  130. 2110 RETURN
  131. 2120 '
  132. 2130 READ J1,J2:FOR J=J1 TO J2:READ E$(J):NEXT :RETURN
  133. 2133 READ J1,J2:FOR J=J1 TO J2:READ D$(J):NEXT :RETURN
  134. 2140 '
  135. 2150 '  Save to disk and close file or cancel new redefinitions
  136. 2160 '
  137. 2170 LOCATE 25,1:PRINT STRING$(79,0);:LOCATE 25,1:PRINT "Write key redefinitions to file ";F$;"? Yes/No: ";
  138. 2175 I$=INPUT$(1):IF INSTR("Yy"+chr$(13),I$)=0 THEN PRINT "NO";:GOTO 2220 ELSE PRINT "YES";
  139. 2177 LOCATE 25,1:PRINT STRING$(79,0);:LOCATE 25,1:PRINT "Writing key redefinitions to file ";F$;" .........";
  140. 2180 OPEN "o",#1,F$
  141. 2190 FOR N=1 TO NK
  142. 2200 PRINT #1,C$(N)
  143. 2210 NEXT N:CLOSE 1
  144. 2220